# Встановлення та підключення пакетів, якщо вони ще не встановлені
if (!require(DBI)) install.packages("DBI")
if (!require(RSQLite)) install.packages("RSQLite")
if (!require(dplyr)) install.packages("dplyr")
if (!require(randomForest)) install.packages("randomForest", repos = "https://cloud.r-project.org/")
if (!require(knitr)) install.packages("knitr")
if (!require(GGally)) install.packages("GGally")
if (!require(caret)) install.packages("caret", repos = "https://cloud.r-project.org/")
# Підключення бібліотек
library(DBI)
library(RSQLite)
library(dplyr)
library(knitr)
library(randomForest)
library(GGally)
library(caret)
Виконання індивідуального завдання: оцінка популярності водіїв
Отримання даних
# Вказання шляху до бази даних SQLite
sqlite_db_path <- "driver_popularity.db"
# Підключення до SQLite для використання збережених даних
sqlite_conn <- dbConnect(SQLite(), dbname = sqlite_db_path)
# Отримання даних з таблиці driver_popularity в SQLite
driver_data <- dbGetQuery(sqlite_conn, "SELECT * FROM driver_popularity WHERE completed_orders > 0")
# Закриття з'єднання
dbDisconnect(sqlite_conn)
# Перегляд перших рядків даних
head(driver_data)
## driver_id completed_orders canceled_orders proposals_created total_earnings
## 1 1 61 47 518 1409.4559
## 2 6 225 52 1433 1766.8871
## 3 50 883 116 8463 7494.3635
## 4 63 721 48 1867 6979.3543
## 5 143 308 42 886 1464.3243
## 6 155 52 4 1049 471.1283
Генерація тестового проекту, створення моделей та їх оценка
# Перевірка кореляцій між змінними
driver_data %>%
select(completed_orders, canceled_orders, proposals_created, total_earnings) %>%
cor() %>%
knitr::kable(caption = "Таблиця коефіцієнтів кореляції")
Таблиця коефіцієнтів кореляції
| completed_orders |
1.0000000 |
0.8953766 |
0.627939 |
0.9548721 |
| canceled_orders |
0.8953766 |
1.0000000 |
0.671784 |
0.9117306 |
| proposals_created |
0.6279390 |
0.6717840 |
1.000000 |
0.7030130 |
| total_earnings |
0.9548721 |
0.9117306 |
0.703013 |
1.0000000 |
driver_data %>%
select(completed_orders, canceled_orders, proposals_created, total_earnings) %>%
ggpairs()

Скористаємося покроковою процедурою включення з вилученням слабких
предикторів
model <- lm(total_earnings ~ completed_orders, data = driver_data_filter)
modelStep <- step(model, trace = 0)
summary(modelStep)
##
## Call:
## lm(formula = total_earnings ~ completed_orders, data = driver_data_filter)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10196.7 -300.7 -246.8 0.3 20376.1
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 305.87671 20.74101 14.75 <2e-16 ***
## completed_orders 5.51728 0.02526 218.41 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1233 on 3917 degrees of freedom
## Multiple R-squared: 0.9241, Adjusted R-squared: 0.9241
## F-statistic: 4.77e+04 on 1 and 3917 DF, p-value: < 2.2e-16
## Analysis of Variance Table
##
## Model 1: total_earnings ~ completed_orders
## Model 2: total_earnings ~ completed_orders
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 3917 5955106744
## 2 3917 5955106744 0 0
Виконаємо тестування двох моделей з використанням десятикратної
перехресної перевірки (cross validation).
modelTrain = train(total_earnings ~ completed_orders + canceled_orders + proposals_created,
data = driver_data_filter,
method = 'lm',
trainControl = trainControl(method = "cv")
)
modelTrainStep <- train(total_earnings ~ completed_orders,
data = driver_data_filter,
method = 'lm',
trainControl = trainControl(method = "cv")
)
modelTrain
## Linear Regression
##
## 3919 samples
## 3 predictor
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 3919, 3919, 3919, 3919, 3919, 3919, ...
## Resampling results:
##
## RMSE Rsquared MAE
## 995.0842 0.9497977 392.0482
##
## Tuning parameter 'intercept' was held constant at a value of TRUE
## Linear Regression
##
## 3919 samples
## 1 predictor
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 3919, 3919, 3919, 3919, 3919, 3919, ...
## Resampling results:
##
## RMSE Rsquared MAE
## 1236.603 0.9242523 553.6888
##
## Tuning parameter 'intercept' was held constant at a value of TRUE
Цю модель можна покращити, вилучивши константу зі специфікації
моделі
modelForCompleted <- lm(total_earnings ~ completed_orders - 1, data = driver_data_filter)
summary(modelForCompleted)
##
## Call:
## lm(formula = total_earnings ~ completed_orders - 1, data = driver_data_filter)
##
## Residuals:
## Min 1Q Median 3Q Max
## -11304.2 4.4 56.3 290.1 20279.5
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## completed_orders 5.63404 0.02464 228.6 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1267 on 3918 degrees of freedom
## Multiple R-squared: 0.9303, Adjusted R-squared: 0.9303
## F-statistic: 5.227e+04 on 1 and 3918 DF, p-value: < 2.2e-16




ggplot(driver_data_filter,
aes(x = completed_orders - 1, y = total_earnings,
colour = canceled_orders)) +
labs(title = "Залежність заробітку від кількості виконаних замовлень",
subtitle = "Лінійна регресія з 95% довірчими межами",
caption = "Без коригування. Кольором виділено кількість відхиленних замовлень",
x = "Кількість виконаних замовлень", y = "Дохід") +
geom_point() +
stat_smooth(method=lm, se = TRUE, fullrange = TRUE)

Виходячи з правила “трьох сигм,” для коригування лінійної моделі
доцільно видалення ще двох точок
dataFilterThreeSigma = driver_data %>%
filter(!row_number() %in% c(259, 223, 1654, 3157))
lmByThreeSigma <- lm(total_earnings ~ completed_orders - 1, data = dataFilterThreeSigma)
summary(lmByThreeSigma)
##
## Call:
## lm(formula = total_earnings ~ completed_orders - 1, data = dataFilterThreeSigma)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10794.4 4.8 56.9 296.6 14618.9
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## completed_orders 5.59192 0.02342 238.8 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1199 on 3916 degrees of freedom
## Multiple R-squared: 0.9357, Adjusted R-squared: 0.9357
## F-statistic: 5.701e+04 on 1 and 3916 DF, p-value: < 2.2e-16




ggplot(dataFilterThreeSigma,
aes(x = completed_orders - 1, y = total_earnings,
colour = canceled_orders)) +
labs(title = "Залежність заробітку від кількості виконаних замовлень",
subtitle = "Лінійна регресія з 95% довірчими межами",
caption = "З коригуванням. Кольором виділено кількість відхиленних замовлень",
x = "Кількість виконаних замовлень", y = "Дохід") +
geom_point() +
stat_smooth(method=lm, se = TRUE, fullrange = TRUE)

Точковий та інтервальний прогноз охоплення аудиторії
completedNumber <- data.frame(completed_orders=c(200, 400, 800, 850))
pre <- predict(lmByThreeSigma, completedNumber, interval="confidence")
knitr::kable(cbind(completedNumber, pre),
caption = "Точковий та інтервальний прогноз охоплення аудиторії")
Точковий та інтервальний прогноз охоплення аудиторії
| 200 |
1118.385 |
1109.202 |
1127.568 |
| 400 |
2236.770 |
2218.403 |
2255.136 |
| 800 |
4473.539 |
4436.807 |
4510.272 |
| 850 |
4753.135 |
4714.107 |
4792.164 |